home *** CD-ROM | disk | FTP | other *** search
/ Reverse Code Engineering RCE CD +sandman 2000 / ReverseCodeEngineeringRceCdsandman2000.iso / RCE / Svd Messageboard Arcive / ephemery / data / MBPREP.ZIP / MSGBRD.PL < prev    next >
Encoding:
Text File  |  1999-06-12  |  10.5 KB  |  260 lines
  1. $IN = $ARGV[0] eq '' ? "-" : $ARGV[0];
  2. open(IN) || die "can't open $IN";
  3.  
  4. $slave=     $ARGV[0] eq ''; #is current file slave or main-one
  5. #$skip=0;       #state: skipping or no
  6. #$nothdr=0;     #recording mode; starts with recording header
  7. $level=-1;      #mssg indent
  8. $mbnumber='';   #msgboard number/name
  9.  
  10. ###require "msgflt.pl";
  11. #uses $skip, $slave, $nothdr
  12. #$slave= 1;      #is current file slave or main-one
  13. $skip=0;        #state: skipping or no
  14. $nothdr=0;      #recording mode; starts with recording header
  15.  
  16. sub filtline {          #return 1 if line should be skipped
  17.    if (m|\">Back to main board</A>|i) {
  18.       $skip=0 if $skip==1;      #stop skipping
  19.       $skip=1 if $skip==2;      #if skipping inside-message mssg-thread
  20.       $slave++;
  21. #     s|http:.+mbs\.cgi.acct\=mb(\d{6})\"|mb$1.htm\"|;
  22.       s|<A HREF=\".+mb(\d{6}).*\"|<A HREF=\"mb$1.htm\"|;
  23.       s|<B>||; s|</B>||;
  24.     }
  25.  
  26.    return 1 if m|<!--|;                 #skip comments
  27.    return 1 if m|^<blockquote>|;        #skip whole heading
  28.    return 1 if m/[^<]<img src="/;       #skip any line with pictures
  29.         #stop header accumulating
  30.    if (m/\"#POSTNEW\"/) { $nothdr=1; return 1; }   #skip goto-post-new-message
  31.    if (m/r>rebuilt<c/i) { $nothdr=1; return 1; }   #rebuilt version
  32.  
  33.         #skip listbox-menu-header:
  34.    return 1 if m|javascript:if\(confirm\(\'|; #works if teleportPro used  #http://www.insidetheweb.com/
  35.    return 1 if m|[^<]<option|;                  #skip listbox-menu-0
  36.    return 1 if m|^<option|;                     #skip listbox-menu
  37.    return 1 if m|[^<]<input type=\"submit\"|;   #skip listbox-menu-footer
  38.  
  39.    if (m|</SCRIPT>|) { $skip = 0; return 1; }   #end skipping javascript
  40.    if (m|</body>|)   { $skip = 0; }             #end skipping everything NOW
  41.  
  42.    $skip=1  if m|<SCRIPT language=\"javascript\">|;     #start skipping javascript
  43. #  $skip=1  if m|<FORM ACTION=|;                #start skipping newmsg form
  44.    $skip=1  if m|<center><table border=3><tr><td>|;     #start skipping newmsg form
  45.    $skip=2  if m|[^>]>Message thread:<|;     #start skipping thread-view
  46.  
  47.    return 1 if $skip;
  48.    $skip=1  if m|>Back to main board</A>|;      #start skiping again/new-mssg table
  49.    $skip=1  if m|^ *</TITLE>|;          #start skiping after eo title
  50.    $skip=1  if m|[^<]</TITLE>|;         #start skiping after eo title
  51.    return 0;
  52. }
  53. ###1;      #needed by "require()" operator
  54. ####eo require
  55.  
  56. $z = '';        #input line
  57. ## this doesn't work if one mssg-link is >1 line! (coz <IN> divides by CRLF)!
  58. sub getTree {
  59.         #to be able to process already rebuilt .htm
  60.       $level=0 if ($z =~ m/^ *<hr size=/i);
  61.         #to be able to process already rebuilt .htm
  62.       while ($z =~ m|^ *<ul>|i)  { $level++; $z =~ s|^ *<ul>||i; }
  63.       while ($z =~ m|^ *</ul>|i) { $level--; $z =~ s|^ *</ul>||i; }
  64. #     if ($z =~ m|[^<]<font size=\"-1\"|i) {    #.' face='
  65.       if ($z =~ m|[^<]<A HREF=|i || $lineprev ne '') {
  66.          $z =~ s/<BR>$//i;
  67.          $z =~ s/\n$//;
  68.                 #for the new sectioned format
  69.          $z =~ s/^[ \t]*<td>\d+  //i; #strip root messages (if numbered)
  70.          $z =~ s/^[ \t]*<td>//i;    #strip root messages (notnumbered)
  71.          $z =~ s|</td>||gi;                     #strip -/-
  72.          if ($lineprev ne '') {
  73.             $z = $lineprev.$z; $lineprev = '';
  74.           } elsif ($z =~ m| *<A HREF=\"[^\"]+\">$|i) {
  75.             $lineprev=$z;
  76.             return;
  77.           }
  78.                 #eo for the new sectioned format
  79.  
  80.          $z =~ s/^ *<hr size=.>//i;     #strip
  81.          $z =~ s"(<TABLE WIDTH=100%><TR><TD>|</TD></TR></TABLE>)""gi;
  82.          $z =~ s/<font size=\".{1,2}\" face=\"arial,helvetica\">//gi;
  83.          $z =~ s/<FONT SIZE=\".{1,2}\">//gi;
  84.          $z =~ s"(<B>|</B>|</font>)""gi;
  85.          (@q) = split( /<A HREF=/i, $z);
  86.          $q[0] =~ s/^ +//;                      #strip trailing spaces
  87. # <href mail> name</a>: <href mssg> subj </a> (n/t) date     : old/original
  88. # <href mssg> subj</a> (n/t) (<href mail> name</a>) date     : new
  89. # newest: date is yyyy
  90.          $old = !($q[0] eq '' && $q[1] =~ /^ *\"\d{8}\..+\">/);
  91. ##       print $old;
  92.          if ($old) {
  93.             if ($#q >= 2) {     #href mail available
  94.                $msgsbj = $q[2]; ($mail,$name) = split( /\">/, $q[1]);
  95.              } else { $mail=''; $name = $q[0]; $msgsbj = $q[1]; }
  96.             ($mssg,$subj) = split( /\">/, $msgsbj);
  97.             $name =~ s/: *$//; $name =~ s|</A>$||i;     #strip :whitespace at end
  98.             ($subj,$date) = split( m|</A>|i, $subj);
  99.          } else {
  100.             if ($#q >= 2) {     #href mail available
  101.                ($mail,$name) = split( /\">/, $q[2]);
  102.                ($name,$date) = split( m|</A>|i, $name);
  103.                $msgsbj = $q[1];
  104.                $nt = ($msgsbj =~ s| +\(n/t\) *||i);
  105.              } else {
  106.                $mail='';
  107.                ($msgsbj,$name) = split( m|</A>|i, $q[1]);
  108.                $name =~ s/^ +//;        #heading spaces
  109.                $nt = ($name =~ s|\(n/t\) +||i);
  110.                (@xx) = split( m| \(|, $name);
  111.                $date = pop(@xx);
  112.                $date = "($date" if ($date !~ /^\(/);
  113.                $name = join( " (", @xx);
  114.                $name =~ s/^ *\(//; $name =~ s/\)$//;
  115.              }
  116.             $date =~ s/^\) *//;                         #strip
  117.             $date = "(n/t) $date" if $nt;
  118.             ($mssg,$subj) = split( /\">/, $msgsbj);
  119.             $subj =~ s|</A> *\(*$||i;    #strip
  120.          }
  121.          $mssg =~ s/^\"//;                      #strip
  122.          $mail =~ s/\"mailto://;
  123.          $date =~ s/^ +//;                      #strip heading spaces
  124.          $date =~ s/-(\d\d)(\d\d) /-$2 /;       #plz 2 digit year
  125.         if (0) {
  126.          print "$z\n";
  127.          for ($t=0; $t<=$#q; $t++) { print "$t:$q[$t].\n"; } print "=====\n";
  128.          print "mail:$mail\nname:$name\nmssg:$mssg\nsubj:$subj\ndate:$date\n---\n";
  129.         }
  130.          $saver[$nmsg] = join( "\f", $level,$mail,$name,$mssg,$subj,$date  ); # ,$z
  131.          $saver[$nmsg] =~ s/ +\f/\f/g;
  132.          $nmsg++;
  133.       } else {
  134.          $lineprev = ''; } #just in case
  135. }
  136.  
  137.  
  138.  
  139. while (<IN>) {            #if using (<>) $ARGV is current file's name
  140.         #new sectioned fmt/changed things
  141.    if (/^<p>\s*$/i && 5==$nothdr) { $skip=0; $nothdr=0; next; }   #stop skiping/topmost listbox
  142.    next if &filtline ;
  143.  
  144.    (@x) = split(/\"/);
  145.    $z='';
  146.    for ($i=0; $i<=$#x; $i++) {
  147.       if ($x[$i] eq " tppabs=") { $i++; next; } #skip tppabs & it's value
  148.  
  149.       if ($x[$i] =~ /mbs.cgi.acct=mb/) {
  150. #        (@y) = split(/\&/);
  151.          (@y) = split(/\&/,$x[$i]);
  152.          if ($mbnumber eq '') {         #get main msgboard number
  153.             $mbnumber=$y[0];
  154.             $mbnumber =~ s/.+mbs.cgi.acct=//i;
  155.           }
  156.        loop1:                           #locate and get current message number
  157.          for ($k=1; $k<$#y; $k++) {
  158.              ($mynum,$nn) = split(/\=/, $y[$k]);
  159.              if ($mynum eq 'MyNum') {
  160.                 $longnm   = $x[$i];   #912345678 -> 12345678.9 #last 8 digits only
  161.                 $x[$i] = substr($nn,-8).".".substr($nn,-9,1);
  162.                 $longnames{ $x[$i] } = $longnm;
  163.                 last loop1;
  164.               }
  165.           }
  166.        }
  167.       $z .= '"' if $i;
  168.       $z .= $x[$i];
  169.    }
  170.  
  171. #    print $z;
  172.  
  173.    $z =~ s/<BR>[^>\n]/<BR>\n/;      #??
  174.    $hdr[$h++] = $z if !$nothdr;
  175.          #new sectioned fmt/changed things
  176.          #start skiping/topmost listbox 1st time only
  177.    if ($z =~ m/^<body/i && !$nothdr) { $skip=1; $nothdr=5; next; }
  178.  
  179.    do getTree() if !$slave;      #now tree extracting:
  180. }
  181. close IN;
  182.  
  183. ################
  184.  
  185. if (!$slave) {
  186.    $mbnumber = "mbnumber" if $mbnumber eq '';
  187.    print "messageboard: $mbnumber\n";
  188.    $IN = "$mbnumber.tre";
  189.    if (open(IN)) {
  190.       print "old tree: $IN\n";
  191.       $i=0; while (<IN>) {
  192.         s/[\r\n]+$//g; s/ +\f/\f/g; ###$_ = substr($_,2);
  193.         $xa{$_} = 1+$i; $ya[$i] = $_; $i++;
  194.        } close IN;
  195.     }
  196.  
  197.    $OUT = ">../$IN";
  198.    open(OUT) || die "can't open $OUT";
  199.    print "new tree: $OUT\n";
  200.  
  201.    $news=0;
  202.         #relies on unique items/lines! if same line is repeated, result is unpredictable
  203.    for ($ia=$ib=0; $ib<=$#saver && $ia<=$#ya; $ib++) {
  204.        $n = $xa{ $saver[$ib] };
  205.        if ($n) {          #(!) it is 1 more
  206.           for ( ;$ia<$n;$ia++) { print OUT "$ya[$ia]\n"; }
  207.           ($level,$mail,$name,$mssg,$subj,$date) = split( "\f", $saver[$ib]);
  208.           undef $longnames{$mssg};      #remove available messages
  209.         } else {
  210.           print OUT "$saver[$ib]\n";
  211.           $news++;
  212.         }
  213.    }
  214.    for ( ;$ib<=$#saver;$ib++) { print OUT "$saver[$ib]\n"; $news++; }
  215.    for ( ;$ia<=$#ya;$ia++)    { print OUT "$ya[$ia]\n";
  216.      ($level,$mail,$name,$mssg,$subj,$date) = split( "\f", $ya[$ia]);
  217.      undef $longnames{$mssg};      #remove available messages
  218.    }
  219.    close OUT;
  220.  
  221. #  $OUT = ">re_name.bat"; open(OUT) || die "can't open $OUT";
  222.     $OU2 = ">getonly.htm";
  223.     open(OU2) || die "can't open $OU2";
  224.    print "page to retrieve new messages only: $OU2  ($news)\n";
  225.     for ($h=0; $h<=$#hdr; $h++) { print OU2 $hdr[$h]; } #prologue
  226.    $SITE = "http://www.insidetheweb.com/messageboard/";
  227.    foreach $k (keys %longnames) {    #only missing messages
  228.       $http = $longnames{$k};
  229.       $http =~ s|$SITE||i;      #remove URL if any
  230.       $kk = $k; $kk =~ s/\.9/\.HTM/;
  231. #     print OUT "type  \"$http\" | perl $0 >..\\$kk\n" if $http ne '';
  232.       $http =~ s/mbs\.cgi./mbs\.cgi\?/i;
  233.       $http =~ s/(MyNum=)(\d+).*$/$1$2&TL=$2&P=No/;     #avoid thread above
  234. ###   $http =~ $SITE.$http if $http !~ m|$SITE|;
  235.       print OU2 "<A HREF=\"$SITE$http\"> $k </A><BR>\n" if $longnames{$k} ne '';
  236.    }
  237.     print OU2 "</body></html>\n";  #epilogue
  238.    close OU2;
  239.  
  240.    $OUT = ">../$mbnumber.hdr";          #prologue
  241.    open(OUT) || die "can't open $OUT";
  242.    print "header: $OUT\n";
  243.    for ($h=0; $h<=$#hdr; $h++) { print OUT $hdr[$h]; }
  244.    close OUT;
  245. } else { #if used over single message... but better use msg2.pl
  246.    for ($h=0; $h<=$#hdr; $h++) { print     $hdr[$h]; }
  247. }
  248.  
  249. #derived structure:
  250. #       struct { thread-start MyNum=NNN/TL=NNN; //older msgb:TL is missing
  251. #                -m1. MyNum=XXX/TL=NNN
  252. #                -m2  MyNum=YYY/TL=NNN
  253. #                ...    which is where depends on <ul> and </ul> found
  254. #                               <ul> indents one level; </ul> outdents
  255. #               } <HR size=0>
  256. #so possible actions:
  257. # if parser saves the tree, tree+separate messages are enough to rebuild;
  258. # then, get the new tree, merge, add new messages
  259. # SvD 01'99
  260.